home *** CD-ROM | disk | FTP | other *** search
/ Gold Medal Software 1 / Gold Medal Software Volume 1 (Gold Medal) (1994).iso / prog / tpwprog7.arj / PABORT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-07-02  |  4.2 KB  |  174 lines
  1. { pabort.pas -- Test printer abort function and dialog }
  2.  
  3. program PAbort;
  4.  
  5. {$R pbitmap.res}    { Uses PBitMap's resource file }
  6.  
  7. uses WinTypes, WinProcs, WObjects, UBitmap, UAbort;
  8.  
  9. const
  10.  
  11.   fileName = 'c:\tpw\owldemos\nolimits.bmp';
  12.  
  13.   id_Menu  = 100;    { Menu resource ID }
  14.   cm_Print = 101;    { Menu:Print command ID }
  15.   cm_Quit  = 102;    { Menu:Exit command ID }
  16.  
  17. type
  18.  
  19.   PAbortApplication = object(TApplication)
  20.     procedure InitMainWindow; virtual;
  21.   end;
  22.  
  23.   PPAbortWindow = ^PAbortWindow;
  24.   PAbortWindow = object(TWindow)
  25.     Bitmap: HBitmap;   { Handle to bitmap in memory }
  26.     Width, Height: LongInt; { Size of bitmap image }
  27.     constructor Init(AParent: PWindowsObject; ATitle: PChar);
  28.     destructor Done; virtual;
  29.     procedure SetupWindow; virtual;
  30.     function CanClose: Boolean; virtual;
  31.     procedure AdjustScroller;
  32.     procedure Paint(PaintDC: HDC;
  33.       var PaintInfo: TPaintStruct); virtual;
  34.     procedure WMSize(var Msg: TMessage);
  35.       virtual wm_First + wm_Size;
  36.     procedure CMPrint(var Msg: TMessage);
  37.       virtual cm_First + cm_Print;
  38.     procedure CMQuit(var Msg: TMessage);
  39.       virtual cm_First + cm_Quit;
  40.   end;
  41.  
  42.  
  43. { PAbortApplication }
  44.  
  45. {- Initialize PAbortApplication object's window }
  46. procedure PAbortApplication.InitMainWindow;
  47. begin
  48.   MainWindow := New(PPAbortWindow, Init(nil, 'PAbort'))
  49. end;
  50.  
  51.  
  52. { PAbortWindow }
  53.  
  54. {- Construct PAbortWindow object }
  55. constructor PAbortWindow.Init(AParent: PWindowsObject; ATitle: PChar);
  56. begin
  57.   TWindow.Init(AParent, ATitle);
  58.   with Attr do
  59.   begin
  60.     X := 10; Y := 10; W := 500; H := 300;
  61.     Menu := LoadMenu(HInstance, PChar(id_Menu));
  62.     Style := Style or ws_VScroll or ws_HScroll;
  63.   end;
  64.   Scroller := New(PScroller, Init(@Self, 1, 1, 200, 200))
  65. end;
  66.  
  67. {- Destroy PAbortWindow }
  68. destructor PAbortWindow.Done;
  69. begin
  70.   if Bitmap <> 0 then DeleteObject(Bitmap);
  71.   TWindow.Done
  72. end;
  73.  
  74. {- Load and display bitmap }
  75. procedure PAbortWindow.SetupWindow;
  76. begin
  77.   TWindow.SetupWindow;
  78.   Bitmap := LoadBitmap(fileName, HWindow, Width, Height);
  79.   if Bitmap = 0 then
  80.   begin
  81.     MessageBox(HWindow, 'File not found', 'Error',
  82.       mb_IconExclamation or mb_ok);
  83.     Halt
  84.   end
  85. end;
  86.  
  87. {- Return true if okay to close window }
  88. function PAbortWindow.CanClose: Boolean;
  89. begin
  90.   CanClose := not Printing
  91. end;
  92.  
  93. {- Adjust scroll bar ranges after window size changes }
  94. procedure PAbortWindow.AdjustScroller;
  95. var
  96.   ClientRect: TRect;
  97. begin
  98.   GetClientRect(HWindow, ClientRect);
  99.   with ClientRect do
  100.     Scroller^.SetRange(Width - (Right - Left),
  101.       Height - (Bottom - Top));
  102.   Scroller^.ScrollTo(0, 0);
  103.   InvalidateRect(HWindow, nil, true)
  104. end;
  105.  
  106. {- Respond to changes in window size }
  107. procedure PAbortWindow.WMSize(var Msg: TMessage);
  108. begin
  109.   TWindow.WMSize(Msg);
  110.   if not (Msg.WParam = sizeIconic) then
  111.     AdjustScroller
  112. end;
  113.  
  114. {- Paint bitmap inside window }
  115. procedure PAbortWindow.Paint(PaintDC: HDC;
  116.   var PaintInfo: TPaintStruct);
  117. var
  118.   MemDC: HDC;
  119.   OldBitmap: HBitmap;
  120. begin
  121.   TWindow.Paint(PaintDC, PaintInfo);
  122.   if Bitmap <> 0 then
  123.   begin
  124.     MemDC := CreateCompatibleDC(PaintDC);
  125.     OldBitmap := SelectObject(MemDC, Bitmap);
  126.     BitBlt(PaintDC, 0, 0, Width, Height, MemDC, 0, 0, SRCCopy);
  127.     SelectObject(MemDC, OldBitmap);
  128.     DeleteDC(MemDC)
  129.   end
  130. end;
  131.  
  132. {- Execute Menu:Print command }
  133. procedure PAbortWindow.CMPrint(var Msg: TMessage);
  134. var
  135.   DC, MemDC: HDC;
  136.   OldBitmap: HBitmap;
  137. begin
  138.   if (Bitmap <> 0) and PrnStart('PAbort') then
  139.   begin
  140.     DC := GetDC(HWindow);
  141.     MemDC := CreateCompatibleDC(DC);
  142.     ReleaseDC(HWindow, DC);
  143.     OldBitmap := SelectObject(MemDC, Bitmap);
  144.     BitBlt(PDc, 0, 0, Width, Height, MemDC, 0, 0, SRCCopy);
  145.     NewPage;
  146.     PrnStop;
  147.     SetFocus(HWindow);
  148.     SelectObject(MemDC, OldBitmap);
  149.     DeleteDC(MemDC)
  150.   end
  151. end;
  152.  
  153. {- Execute Menu:Exit command }
  154. procedure PAbortWindow.CMQuit(var Msg: TMessage);
  155. begin
  156.   CloseWindow
  157. end;
  158.  
  159. var
  160.  
  161.   PAbortApp: PAbortApplication;
  162.  
  163. begin
  164.   PAbortApp.Init('PAbortApp');
  165.   PAbortApp.Run;
  166.   PAbortApp.Done
  167. end.
  168.  
  169.  
  170. {--------------------------------------------------------------
  171.   Copyright (c) 1991 by Tom Swan. All rights reserved.
  172.   Revision 1.00    Date: 5/17/1991
  173. ---------------------------------------------------------------}
  174.